home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / NEWSOFT / AUGUST / WORKDISC / !Forthmacs / risc_os / whatis < prev    next >
Text File  |  1997-02-25  |  2KB  |  71 lines
  1. \ whatis_doc extraction for Risc_OS
  2.  
  3. decimal
  4.  
  5. only forth also hidden definitions
  6. : w_doc    p" <Forthmacs$Dir>.risc_os.whatis_doc" ;
  7. : w_ind    p" <Forthmacs$Dir>.risc_os.whatis_ind" ;
  8.  
  9. 128 32 - cells constant  /index
  10. /index buffer: index
  11. 260    buffer: linebuf
  12.  
  13. variable index-read index-read off
  14.  
  15. : ?read-index    ( filename -- )
  16.     index-read @ 0=
  17.     if    w_ind read-open
  18.         index /index erase
  19.         index /index ifd @ fgets
  20.         /index <> if -331 throw then
  21.         ifd @ fclose
  22.         index-read on
  23.     then ;
  24. : dropline    ( -- )        newline ifd @  fskiptill  ;
  25. : getline    ( -- line )    linebuf newline ifd @  fgettill ;
  26. : showit    ( str -- )    ". space getline ". cr    getline ". cr  ;
  27.  
  28. : (>index    ( str -- adr )    char+ c@  bl - cells index + ;
  29. : >index    ( str -- off)    (>index @ ;
  30. : file-search    ( str -- str found? )
  31.     begin    pad ifd @ fgetword over "=
  32.         if true exit then  dropline dropline
  33.         eof? if false exit then
  34.     again ;
  35.  
  36. : no-help    ( str -- )
  37.     ".  d# -614 .error  cr ;
  38. : (whatis    ( str -- )
  39.     ?read-index
  40.     w_doc read-open
  41.     dup >index   ( str file-offset) dup 0<
  42.     if    drop no-help
  43.     else    ifd @ fseek   ( str)
  44.         file-search   ( str flag)
  45.         if  showit  else  no-help then
  46.     then
  47.     ifd @ fclose ;
  48.  
  49. variable tell-index
  50. : indexes    (s -- )
  51.     index /index erase
  52.     w_doc read-open  ifd @ 0= if d# -332 throw then
  53.     begin    eof? 0=
  54.     while    ifd @ ftell >r
  55.         getline  dup >index
  56.         if    drop
  57.         else    (>index r@ swap !
  58.         then
  59.         dropline r> drop
  60.     repeat    ifd @ fclose  ifd off
  61.     w_ind new-file
  62.     index /index ofd @  fputs  ofd @ fclose    ofd off ;
  63.  
  64. only forth hidden also forth definitions
  65.  
  66. : (cold-hook    (cold-hook index-read off ;  ' (cold-hook is cold-hook 
  67. : whatis  \ word  ( -- )
  68.     blword (whatis ;
  69.  
  70. only forth also definitions
  71.